/* REXX _ztm.zrx by the reverend (build 108)                                  */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:25        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  zero turn mapper.                                            */
/* rev. 0 - initial release                                                   */
/* rev. 1 - bug fix - possible data corruption between passes                 */
/* rev. 2 - efficiency enhancements for visited sectors                       */
/* rev. 3 - reversed void plots for bubble accuracy (thanks dr. bad)          */
/* rev. 4 - fixed the hang when sysop changes max warp length                 */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals()
call on halt name _halt
call _rseed
loaded=0
_g.6=loaded

call _newline _ansi("bt;fgr")
parse value _getgameinfo() with spath ";" iname ";" game
parse value zocgetoption("CaptDefaultName") with . '="' logdefault '"'
_g.4=logdefault

ns=_ini_askint("how many sectors in this game?", 5000, iname, game, "ns")
if ns<1 | ns>20000 then call _error "number out of range"
fname=_ini_askstr("enter ztm filename (no extension):", "cim", iname, game, "cim")
if fname="" then call _error "script cancelled by user"
parse value _getloginfo() with lpath ";" ldefault
fname=lpath||fname

_g.1=ns
_g.2=fname

_sv.=0
_s.=""
if _fileexists(fname||".sct") then call _loadsectorcim fname||".sct"
do i=1 to ns
 if _s.i\="" then _sv.i=1
end /*do*/
if _fileexists(fname||"_ref.sct") then call _loadsectorcim fname||"_ref.sct"
loaded=1
_g.6=loaded

buffsize=32*1024
backup=100

defaults=0
ans=99
do while ans>0
 ans=_drequestlisti("ztm method?", "ONE-PASS;1-2,3-4,...;1-5000,2-4999,...;randoms;one-ways;terra;void-pass;ALL", ";")
 method=ans-1
 _g.3=method
 select
  when ans=0 then nop
  when ans=1 then do
   defaults=1
   method=1
   _g.3=method
   call _pass1
   method=2
   _g.3=method
   call _pass2
   method=3
   _g.3=method
   call _randoms
   method=4
   _g.3=method
   call _oneways
   defaults=0
   ans=0
  end /*when*/
  when ans=2 then call _pass1
  when ans=3 then call _pass2
  when ans=4 then call _randoms
  when ans=5 then call _oneways
  when ans=6 then call _terra
  when ans=7 then do
   method=6
   _g.3=method
   call _voidplot
   method=4
   _g.3=method
   defaults=1
   call _oneways
   defaults=0
   ans=0
  end /*when*/
  when ans=8 then do
   defaults=1
   method=1
   _g.3=method
   call _pass1
   method=2
   _g.3=method
   call _pass2
   method=3
   _g.3=method
   call _randoms
   method=4
   _g.3=method
   call _oneways
   defaults=0
   method=6
   _g.3=method
   call _voidplot
   method=4
   _g.3=method
   defaults=1
   call _oneways
   defaults=0
   ans=0
  end /*when*/
  otherwise nop
 end /*select*/
end /*do*/
exit

_pass1:
 if defaults then start=1
 else start=_asknum("start at what sector?", 1, "c")
 finish=ns
 restart=1
 _g.5=restart
 if start//2=0 then start=start+1
 if finish//2=0 then finish=finish-1
 text=""

 call zoclogging 0, 1
 call zoclogname fname||"_pass1"||".ztm"
 call zoclogging 1, 1

 call zocreceivebuf(buffsize)
 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"
 do sector1=start to finish by 2
  sector2=sector1+1
  if \_sv.sector1 | \_sv.sector2 then do
   restart_temp=sector1
   _g.5=restart
   text=text||"f"||sector1||"^M"||sector2||"^M^M"
   twait="FM > "||sector1||"|warps from sector "||sector1
   _g.7=twait
   if length(text)>220 then do
    call _sendtext text, buffsize
    restart=restart_temp+2
    _g.5=restart
    text=""
   end /*if*/
  end /*if*/
 end /*do*/
 if text\="" then call _sendtext text, 0

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call _savesectorcim fname||"_ref.sct", ns
 call zocwriteln
return

_pass2:
 if defaults then start=1
 else start=_asknum("start at what sector?", 1, "c")
 finish=ns
 restart=1
 _g.5=restart
 if start//2=0 then start=start+1
 if finish//2=0 then finish=finish-1
 text=""

 call zoclogging 0, 1
 call zoclogname fname||"_pass2"||".ztm"
 call zoclogging 1, 1

 call zocreceivebuf(buffsize)
 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"
 do sector1=start to finish by 2
  sector2=ns-sector1+1
  if \_sv.sector1 | \_sv.sector2 then do
   restart_temp=sector1
   _g.5=restart
   text=text||"f"||sector1||"^M"||sector2||"^M^M"
   twait="FM > "||sector1||"|warps from sector "||sector1
   _g.7=twait
   if length(text)>220 then do
    call _sendtext text, buffsize
    restart=restart_temp+2
    _g.5=restart
    text=""
   end /*if*/
  end /*if*/
 end /*do*/
 if text\="" then call _sendtext text, 0

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call _savesectorcim fname||"_ref.sct", ns
 call zocwriteln
return

_randoms:
 if defaults then iter=ns%10
 else iter=_asknum("how many pairs?",ns%10)
 restart=iter
 _g.5=restart
 restart_temp=restart
 text=""

 call zoclogging 0, 1
 call zoclogname fname||"_randoms"||".ztm"
 call zoclogging 1, 1

 call zocreceivebuf(buffsize)
 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"
 do iter
  restart_temp=restart_temp-1
  sector1=random(1,ns)
  sector2=random(1,ns)
  do while sector1=sector2
   sector1=random(1,_rseed(ns))
   sector2=random(1,ns)
  end /*do*/
  if \_sv.sector1 | \_sv.sector2 then do
   text=text||"f"||sector1||"^M"||sector2||"^M"
   twait="FM > "||sector1||"|warps from sector "||sector1
   _g.7=twait
   if length(text)>220 then do
    call _sendtext text, buffsize
    restart=restart_temp-1
    _g.5=restart
    text=""
   end /*if*/
  end /*if*/
 end /*do*/
 if text\="" then call _sendtext text, 0

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call _savesectorcim fname||"_ref.sct", ns
 call zocwriteln
return

_oneways:
 if defaults then start=1
 else start=_asknum("start at what sector?", 1, "c")
 finish=ns
 restart=1
 _g.5=restart
 text=""

 call zoclogging 0, 1
 call zoclogname fname||"_oneways"||".ztm"
 call zoclogging 1, 1

 call zocreceivebuf(buffsize)
 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"

 do sector=start to finish
  restart_temp=sector
  _g.5=restart
  do i=1 to _dwords(_s.sector,";")
   sec=_dword(_s.sector,i,";")
   if \_sv.sec then do
    if \_listin(sector,_s.sec) then do
     text=text||"f"||sec||"^M"||sector||"^M"
     twait="FM > "||sec||"|warps from sector "||sec
     _g.7=twait
    end /*if*/
    if length(text)>220 then do
     call _sendtext text, buffsize
     restart=restart_temp+1
     _g.5=restart
     text=""
    end /*if*/
   end /*if*/
  end /*do*/
 end /*do*/
 if text\="" then call _sendtext text, 0

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call _savesectorcim fname||"_ref.sct", ns
 call zocwriteln
return


_terra:
 if defaults then start=2
 else start=_asknum("start at what sector?", 2, "c")
 if start<2 then start=2
 finish=ns
 restart=2
 _g.5=restart
 text=""

 call zoclogging 0, 1
 call zoclogname fname||"_terra"||".ztm"
 call zoclogging 1, 1

 call zocreceivebuf(buffsize)
 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"

 do sector=start to finish
  restart_temp=sector
  _g.5=restart
  text=text||"f1^M"||sector||"^M"
  twait="  TO > "||sector||"|to sector "||sector
  _g.7=twait
  if length(text)>220 then do
   call _sendtext text, buffsize
   restart=restart_temp+1
   _g.5=restart
   text=""
  end /*if*/
 end /*do*/
 if text\="" then call _sendtext text, 0

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call _savesectorcim fname||"_ref.sct", ns
 call zocwriteln
return

_voidplot:
 call zoclogging 0, 1
 call zoclogname fname||"_void"||".ztm"
 call zoclogging 1, 1

 start=_asknum("start at what sector?", 1, "c")
 if start<1 then start=1
 finish=ns
 restart=start
 _g.5=restart

 call zocsend "^^?"
 if zocwait("Interrogation Modes")=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"
 changed=0

 do current=start to finish

  if \_sv.current then do

   restart=current
   _g.5=restart

   voidlist=translate(_s.current," ",";")
   numwarps=words(voidlist)

   if numwarps<6 then do
    macro=""
    do i=1 to numwarps
     macro=macro||"s"||word(voidlist,i)||"^M"
    end /*do*/
    call zocsend macro

    if current<11 then morevoids=_plotandvoid(current, 11, 0, 1)
                  else morevoids=_plotandvoid(1, current, 1, 1)
    do while morevoids="##ADJACENT##"
     target=random(ns)
     if target\=current then do
      if current<11 then morevoids=_plotandvoid(current, target, 0, 1)
                    else morevoids=_plotandvoid(target, current, 1, 1)
     end /*if*/
    end /*do*/
    if morevoids\="" then do
     voidlist=voidlist||" "||translate(morevoids," ",";")
     changed=1
    end /*if*/
   end /*if*/

   if current//backup=(backup-1) & changed then do
    call zoclogging 0, 1
    call _savesectorcim fname||"_ref.sct", ns
    call zocwriteln _ansi("bt;fwh")
    call zoclogging 1, 1
    changed=0
   end /*if*/

  end /*if*/

 end /*do*/

 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"

 call zoclogging 0, 1
 call zoclogname logdefault
 call zoclogging 1, 1

 call _savesectorcim fname||"_ref.sct", ns
return

_sendtext:
 call zocsend arg(1)
 if zocwaitmux(twait)=640 then call _error "timeout"
 if zocwait(":")=640 then call _error "timeout"
 call _plugin zocreceivebuf(arg(2))
return

_plugin:
 pbuff=arg(1)
 pfr=0
 pto=0
 pi=1
 pj=pos(d2c(13),pbuff,pi)
 do while pj>0
  line=_space(translate(substr(pbuff,pi,pj-pi),"      ",">:()"||d2c(0)||d2c(10)))
  select
   when left(line,2)="FM" then pto=0
   when left(line,2)="TO" then pto=0
   when left(line,9)="*** Error" then pto=0
   when left(line,13)="Clear Avoids?" then pto=0
   when left(line,3)="END" then pto=0
   when strip(line)="" then pto=0
   otherwise do
    do stk=1 to words(line)
     pfr=pto
     pto=word(line,stk)
     if pfr>0 then _s.pfr=_listadd(pto,_s.pfr,1)
    end /*do*/
   end /*otherwise*/
  end /*select*/
  pi=pj+1
  pj=pos(d2c(13),pbuff,pi)
 end /*do*/
return

/* custom version of halt */
_halt: procedure expose (globals)
 call off halt
 ns=_g.1
 fname=_g.2
 method=_g.3
 logdefault=_g.4
 restart=_g.5
 loaded=_g.6
 twait=_g.7

 if method<6 & method>0 then do
  if zocwait(twait)=640 then call _error "timeout"
  if zocwait(":")=640 then call _error "timeout"
  call _plugin zocreceivebuf(0)
 end /*if*/
 call zocsend "q"
 if zocwait("ENDINTERROG")=640 then call _error "timeout"
 call zoclogging 0, 1
 call zoclogname logdefault
 call _savesectorcim fname||"_ref.sct", ns
 call zoclogging 1, 1
 call _newline
 select
  when method=1 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart PASS1 at sector "||restart||". >>^[[0;35m "
  when method=2 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart PASS2 at sector "||restart||". >>^[[0;35m "
  when method=3 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart RANDOMS for "||restart||" MORE PAIRS. >>^[[0;35m "
  when method=4 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart ONEWAYS at sector "||restart||". >>^[[0;35m "
  when method=5 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart TERRA at sector "||restart||". >>^[[0;35m "
  when method=6 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart VOIDPASS at sector "||restart||". >>^[[0;35m "
  otherwise nop
 end /*select*/
 exit
return

/* custom version of _error */
_error: procedure expose (globals)
 ns=_g.1
 fname=_g.2
 method=_g.3
 logdefault=_g.4
 restart=_g.5
 loaded=_g.6
 twait=_g.7

 version=zocgetinfo("VERSION")
 osys=zocgetinfo("OSYS")
 address=zocgetinfo("CONNECTEDTO")
 if arg(1)="" then msg="<< script error. >>"
 else msg="<< script error:  "||arg(1)||" >>"
 mail="<< if this is a serious problem, email me at: the.reverend@coastgames.com >> "
 debug="<< ZOC "||version||", OS "||osys||", LOC "||address||" >>"
 if zocgetinfo("CURSOR-X")>0 then call zocwriteln
 call zocwriteln "^[[1;31m"||msg||"^[[0;35m"
 if arg(1)\="timeout" then do
  call zocwriteln "^[[1;33m"||mail
  call zocwriteln debug||"^[[0;35m"
 end /*if*/
 call _beep "error.wav"

 if loaded & arg(1)="timeout" then do
  call zoclogging 0, 1
  call zoclogname logdefault
  call _savesectorcim fname||"_ref.sct", ns
  call zoclogging 1, 1
  call _newline
  select
   when method=1 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart PASS1 at sector "||restart||". >>^[[0;35m "
   when method=2 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart PASS2 at sector "||restart||". >>^[[0;35m "
   when method=3 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart RANDOMS for "||restart||" MORE PAIRS. >>^[[0;35m "
   when method=4 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart ONEWAYS at sector "||restart||". >>^[[0;35m "
   when method=5 then call zocwriteln "^[[1;33m<< some data has been LOST -- restart TERRA at sector "||restart||". >>^[[0;35m "
   otherwise nop
  end /*select*/
 end /*if*/
 exit
return

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _rseed v.7 **/
    _rseed: procedure expose (globals)
     if arg(1,"E") then width=min(max(arg(1),2),86400)
     else width=1000
     parse value time("L") with r1 ":" r2 ":" r3 "." r4
     r4=strip(left(r4,5))
     seed=r4||copies(0,5-length(r4))
     rslt=random(0, 99999, seed)//width
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _getgameinfo v.5 **/
    _getgameinfo: procedure expose (globals)
     spath=_getscriptpath()
     base=spath||"script.ini"
    
     if arg(1,"E") then fname=arg(1)
     else fname=base
    
     parse value zocgetglobaloption("WindowTitle") with . '="' game '"'
     if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do
      list=_ini_getheadings(fname)
      if list="##EOF##" then game="##EOF##"
      else do
       templist=""
       do i=1 to _dwords(list,";")
        temp=_dword(list,i,";")
        if left(temp,1)\="*" then do
         if templist="" then templist=temp
         else templist=templist||";"||temp
        end /*if*/
       end /*do*/
       list=templist
       game=_drequestlist("select a game:", list, ";", "c")
      end /*else*/
     end /*do*/
    
     call zocwrite _ansi("bt;fgr")||"< using "
     if length(fname)>17 then call zocwrite "..."
     call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >"
    
     rslt=spath||";"||fname||";"||game
    return rslt

/** _ini_askint v.5 **/
    _ini_askint: procedure expose (globals)
     if \arg(1,"E") then msg="enter an integer"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askint"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripint(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripint(default)
      when rslt="##EOF##"                     then rslt=_askint(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripint(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripint(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _ini_askstr v.5 **/
    _ini_askstr: procedure expose (globals)
     if \arg(1,"E") then msg="enter a number"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askstr"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=default
      when rslt="##EOF##"                     then rslt=_askstr(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then nop
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwrite right(fname,min(length(fname),17))||" - "
       call zocwrite key||"="||left(translate(rslt,"~","^"),min(length(rslt),25))
       if length(rslt)>25 then call zocwrite "..."
       call zocwriteln " >"
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _getloginfo v.2 **/
    _getloginfo: procedure expose (globals)
     parse value zocgetoption("CaptDefaultName") with . '="' ldefault '"'
     parse value zocgetglobaloption("CapturePath") with . '="' lpath '"'
     lpath=dosfname(lpath)
     if right(lpath,1)\="\" then lpath=lpath||"\"
     if \dosisdir(lpath) then call _error "invalid path in _getloginfo"
     rslt=lpath||";"||ldefault
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _loadsectorcim v.6 **/
    _loadsectorcim: procedure expose (globals)
     fname=arg(1)
     _s.=""
     call _newline
     call zocwrite _ansi("bt;fcy")||"reading "||fname||" "
     if _fileopenr(fname) then do
      mon=0
      do while \_fileeof(fname)
       parse value strip(linein(fname)) with row line
       if line\="" & row\="" then do
        _s.row=_space(line,1,";")
        mon=_spinner(mon,500)
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*if*/
     else call zocwrite "x"
    return

/** _drequestlisti v.2 **/
    _drequestlisti: procedure expose (globals)
     do i=1 to 3
      if \arg(i,"E") then call _error "missing parameter in _drequestlisti"
     end /*do*/
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     if i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
                                else rslt=i+1
    return rslt

/** _asknum v.4 **/
    _asknum: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an number:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripnum(rslt)\=rslt | rslt=""
      default=rslt||" [please enter a number or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _savesectorcim v.4 **/
    _savesectorcim: procedure expose (globals)
     fname=arg(1)
     ns=arg(2)
     if ns="" then call _error "number of sectors missing."
    
     if \_filenew(fname, "delete") then call _error "unable to create "||fname||"."
    
     call _newline
     call zocwrite _ansi("bt;fcy")||"writing "||fname||" "
    
     mon=0
     wns=length(ns)
     do i = 1 to ns
      if _s.i\="" then do
       line=_pad(i,wns,"R")
       do j=1 to _dwords(_s.i,";")
        temp=_dword(_s.i,j,";")
        line=line||_pad(temp,wns+1,"R")
       end /*do*/
       call lineout fname, line
       mon=_spinner(mon,500)
      end /*if*/
     end /*do*/
    
     call _fileclose fname
    return

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _listin v.3 **/
    _listin: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _listin"
     find=arg(1)
     list=arg(2)
     if arg(3,"E") then delim=left(arg(3),1)
                   else delim=";"
     rslt=0
     do i=1 to _dwords(list,delim)
      if find==_dword(list,i,delim) then do
       rslt=1
       leave
      end /*if*/
     end /*do*/
    return rslt

/** _plotandvoid v.2 **/
    _plotandvoid: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _plotandvoid"
     start=arg(1)
     finish=arg(2)
     if arg(3,"E") then mode=arg(3)  /* 0=void second warp; 1=void second to last warp */
                   else mode=0
     if arg(4,"E") then clear=arg(4) /* 0=do not clear; 1=clear */
                   else clear=0
     list=""
    
     if clear then c="y"
     else c="n"
    
     call zocreceivebuf 5*1024
     call zocsend "f"||start||"^M"||finish||"^M"||c
     ans=zocwaitmux(start||" >","Clear Avoids?","So what's the point?")
     do while ans=0
    
      if zocwait(":")=640 then call _error "timeout"
      buff=translate(zocreceivebuf(5*1024),"  ",d2c(10)||d2c(0))
    
      path=""
      i=pos(start||" > ",buff)
      j=pos(d2c(13),buff,i)
      do while j>i
       line=substr(buff,i,j-i)
       path=path||line
       i=j+1
       j=pos(d2c(13),buff,i)
      end /*do*/
      path=_space(translate(path,"  ;","()>"),0)
    
      if words(translate(path," ",";"))>2 then do
    
       parse var path . ";" temp ";" path
       if \mode then void=temp
       _s.start=_listadd(temp,_s.start,1)
       do while path\=""
        sect=temp
        parse var path temp ";" path
        _s.sect=_listadd(temp,_s.sect,1)
       end /*do*/
       if mode then void=sect
     
       if list="" then list=void
       else list=list||";"||void
    
       call zocsend "s"||void||"^Mf"||start||"^M"||finish||"^M"||c
       ans=zocwaitmux(start||" >","Clear Avoids?","So what's the point?")
    
      end /*if*/
    
      else do
       _s.start=_listadd(finish,_s.start,1)
       ans=1
       list="##ADJACENT##"
      end /*else*/
    
     end /*do*/
     buff=zocreceivebuf(0)
    return list

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _listadd v.3 **/
    _listadd: procedure expose (globals)
     add=arg(1)
     list=arg(2)
     if arg(3,"E") then sort=arg(3)
                   else sort=0
     if arg(4,"E") then delim=arg(4)
                   else delim=";"
     temp1=list
     if list="" then list=add
     else do
      do i=1 to _dwords(add,delim)
       found=0
       do j=1 to _dwords(list,delim)
        if _dword(add,i,delim)=_dword(list,j,delim) then found=1
        if found then leave
       end /*do*/
       if \found then list=list||";"||_dword(add,i,delim)
      end /*do*/
      if \found & sort then list=_listsort(list)
     end /*else*/
    return list

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _getscriptpath v.1 **/
    _getscriptpath:
     parse value zocgetglobaloption("ScriptPath") with . '="' spath '"'
     spath=dosfname(spath)
     if right(spath,1)\="\" then spath=spath||"\"
     if \dosisdir(spath) then call _error "invalid path in _getscriptpath"
    return spath

/** _ini_getheadings v.5 **/
    _ini_getheadings: procedure expose (globals)
     if arg(1,"E") then fname=arg(1)
     else call _error "missing parameter in _ini_getheadings"
     if arg(2,"E") then delim=left(arg(2),1)
     else delim=";"
     list=""
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=strip(linein(fname))
       if left(line,1)="[" then do
        if list="" then list=strip(translate(line,"  ","[]"))
        else list=list||delim||strip(translate(line,"  ","[]"))
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*do*/
     if list="" then list="##EOF##"
    return list

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _ini_read v.1 **/
    _ini_read: procedure expose (globals)
     /* argument check */
     do i=1 to 3
      if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_read."
     end /*do*/
    
     /* name arguments */
     fname=arg(1)
     s=strip(arg(2))
     k=strip(arg(3))
    
     if _fileopenr(fname) then do
      done=0
      found=0
      insection=0
      do while \done & \_fileeof(fname)
       line=strip(linein(fname))
       select
        when left(line,1)=";" then nop
        when line="["||s||"]" then insection=1
        when insection & left(line,1)="[" then done=1
        when insection & left(line,length(k)+1)=k||"=" then do
         v=strip(substr(line,length(k)+2))
         done=1
         found=1
        end /*when*/
        otherwise nop
       end /*select*/
      end /*do*/
      call _fileclose fname 
      if \found then v="##EOF##"
     end /*if*/
     else v="##EOF##"
    
    return v

/** _askint v.2 **/
    _askint: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an integer:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripint(rslt)\=rslt | rslt=""
      default=rslt||" [please enter an integer or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _askstr v.1 **/
    _askstr: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an string:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=zocask(msg, default)
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _spinner v.3 **/
    _spinner: procedure expose (globals)
     if arg(1,"E") then count=arg(1)
                   else call _error "missing parameter in _spinner"
     if arg(2,"E") then width=arg(2)
                   else width=100
     if arg(3,"E") & length(arg(3))=5 then chs=arg(3)
                                      else chs="-\|/."
    /* bs="^H" */
     bs=d2c(27)||"[1D"
     select
      when count=-1        then call zocwrite bs||substr(chs,5,1)
      when count<0         then count=-1
      when count=0         then call zocwrite left(chs,1)
      when count=width     then call zocwrite bs||substr(chs,2,1)
      when count=(width*2) then call zocwrite bs||substr(chs,3,1)
      when count=(width*3) then call zocwrite bs||substr(chs,4,1)
      when count=(width*4) then do
       call zocwrite bs||left(chs,1)
       count=0
      end /*when*/
      otherwise nop
     end /*select*/
     count=count+1
    return count

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _stripnum v.3 **/
    _stripnum: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789."," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if _dwords(rslt,".")>2 then rslt=_dword(rslt,1,".")||"."||_space(translate(substr(rslt,pos(".",rslt)+1)," ","."),0)
     if \datatype(rslt,"N") then rslt=""
    return rslt

/** _filenew v.4 **/
    _filenew: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _filenew"
     if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1)
     if _fileexists(arg(1)) then rslt=0
     else do
      call stream arg(1), "C", "OPEN WRITE"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*else*/
    return rslt

/** _pad v.1 **/
    _pad: procedure expose (globals)
     rslt=arg(1)
     if arg(2,"E") then w=arg(2); else return rslt
     if \arg(3,"E") then m="L"; else m=arg(3)
     select
      when m="L" then rslt=left(rslt,w)
      when m="R" then rslt=reverse(left(reverse(rslt),w))
      when m="C" then rslt=center(rslt,w)
      otherwise       rslt=left(rslt,w)
     end /*select*/
    return rslt

/** _listsort v.3 **/
    _listsort: procedure expose (globals)
     list=arg(1)
     if arg(2,"E") then delim=arg(2)
                   else delim=";"
     a.=""
     do i=1 to _dwords(list,delim)
      a.i=_dword(list,i,delim)
     end /*do*/
     do k=i-1 to 1 by -1
      do j= 1 to k
       j2=j+1
       if a.j>a.j2 then do
        temp=a.j
        a.j=a.j2
        a.j2=temp
       end /*if*/
      end /*do*/
     end /*do*/
     list=a.1
     i=2
     do while a.i\=""
      if list="" then list=a.i
      else list=list||delim||a.i
      i=i+1
     end /*do*/
    return list

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt